home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Utilities / Text Utils / Alpha 5.81 ƒ / Tcl / SystemCode / flags.tcl < prev    next >
Encoding:
Text File  |  1994-07-07  |  3.1 KB  |  146 lines  |  [TEXT/ALFA]
  1.  
  2. set flagFlags ""
  3.  
  4. # The following three procs, together w/ the initialization 
  5. # for the flags below, allow a totally Tcl-controlled menu to 
  6. # shadow Alpha's internal variables.
  7. proc initFlag var {
  8.     global $var flagFlags
  9.     addMenuItem -m Flags $var
  10.     linkVar $var
  11.     lappend flagFlags $var
  12. }
  13.  
  14. # Called for ordinary tcl global vars we want included in the Flags menu.
  15. proc initTclFlag {flag {val 0}} {
  16.     global $flag flagFlags
  17.     addMenuItem -m Flags $flag
  18.     if {![info exists $flag]} {set $flag $val}
  19.     lappend flagFlags $flag
  20. }
  21.  
  22. # Called for ordinary tcl global vars we want included in the Vars menu.
  23. proc initTclVar {var {val ""}} {
  24.     global $var
  25.     if {[string length $val]} {
  26.         set $var $val
  27.     }
  28.     addMenuItem -m Vars $var
  29.     if {![info exists $var]} {set $var 0}
  30. }
  31.  
  32.  
  33. # 'fullNames' needs to be traced to update win menu.
  34. if {![info exists oldFNames]} {set oldFNames 0}
  35. proc shadowFullNames args {
  36.     global winNameToNum fullNames oldFNames winMenu
  37.     
  38.     if {$fullNames == $oldFNames} {return $fullNames}
  39.     set oldFNames $fullNames
  40.     
  41.     if {[catch {set nms [array names winNameToNum]}] == "1"} {
  42.         return $fullNames
  43.     }
  44.     
  45.     if {$fullNames == "1"} {
  46.         foreach name $nms {
  47.             if {$winNameToNum($name) < 10} {
  48.                 set lab /$winNameToNum($name)
  49.             } else {set lab ""}
  50.             regexp {[^:]*$} $name nm
  51.             catch {deleteMenuItem -m $winMenu $nm}
  52.             addMenuItem -m -l $lab $winMenu $name
  53.         }
  54.     } else {
  55.         foreach name $nms {
  56.             if {$winNameToNum($name) < 10} {
  57.                 set lab /$winNameToNum($name)
  58.             } else {set lab ""}
  59.             regexp {[^:]*$} $name nm
  60.             catch {deleteMenuItem -m $winMenu $name}
  61.             addMenuItem -m -l $lab $winMenu $nm
  62.         }
  63.     }
  64.     return $fullNames
  65. }
  66.  
  67. proc initVar var {
  68.     global $var
  69.     linkVar $var
  70.     addMenuItem -m Vars $var
  71. }
  72.  
  73. # This file contains methods allowing the shadowing of tcl variables 
  74.  
  75. initFlag autoHScroll
  76. initFlag autoSave
  77. initTclFlag backup
  78. initFlag blinkingCursor
  79. initFlag blockCursor
  80. initFlag bwWindows
  81. initFlag coloring
  82. initFlag dragAndDrop
  83. initFlag elecLBrace
  84. initFlag elecRBrace
  85. initFlag electricSemi
  86. initFlag fullNames
  87. trace vdelete fullNames w shadowFullNames
  88. trace variable fullNames w shadowFullNames
  89. initFlag horScrollBar
  90. initTclFlag iconifyOnSwitch
  91. initFlag indentOnCR
  92. initTclFlag intelCutPaste 1
  93. initFlag moveInsertion
  94. initFlag openAllFiles
  95. initFlag optionIsMeta
  96. initFlag posActivate
  97. initFlag powerThumb
  98. initFlag projectorAware
  99. initFlag showRowCol
  100. initFlag showInvisibles
  101. initFlag showMenuHeads
  102. initTclFlag smartQuotes 1
  103. initFlag sortedIsDefault
  104. initFlag suppressHeader
  105. initFlag tempMem
  106. initFlag undoOn
  107. initFlag wordWrap
  108.  
  109. initTclVar backExtension "~"
  110. initTclVar backDir
  111. initVar bottomMargin
  112. initVar changesLim
  113. initVar defaultFont
  114. initVar fillColumn
  115. initVar fontSaving
  116. initVar fontSize
  117. initVar funcExpr
  118. initVar funcPar
  119. initVar leftFillColumn
  120. initVar leftMargin
  121. initVar markLabel
  122. initVar markSorting
  123. initVar numWinsToTile
  124. initVar paraColumn
  125. initVar    printerFont
  126. initVar    printerFontSize
  127. initVar savedState
  128. initVar sortColumn
  129. initVar tabSize
  130. initVar tagFile
  131. initVar tileWidth
  132. initVar tileHeight
  133. initVar tileTop
  134. initVar topMargin
  135. initVar wordBreak
  136. initVar wordBreakPreface
  137.  
  138. # Redefine 'menuHook' to update flags menu.
  139. proc menuHook {} {
  140.     uplevel #0 {
  141.         foreach f $flagFlags {
  142.             markMenuItem Flags $f [set $f]
  143.         }
  144.     }
  145. }
  146.